home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / trans.com / TRANSLAT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-02-02  |  5.2 KB  |  125 lines
  1. {$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S+,V-}
  2. {$M 1024,0,655360}
  3.  
  4. { *********************************************************************** }
  5. { TRANSLATE                                                               }
  6. {                                                                         }
  7. { Copyright 1990 by Gil Yoder                                             }
  8. { P.O. Box 307                                                            }
  9. { Coalgate, OK 74538                                                      }
  10. {                                                                         }
  11. { CIS: 73237,3103                                                         }
  12. {                                                                         }
  13. { You may use, copy, distribute, and modify TRANSLATE without restriction }
  14. { but you may not sell TRANSLATE or programs derived herefrom.  If you do }
  15. { modify the program, the author of TRANSLATE would appreciate notifica-  }
  16. { tion.                                                                   }
  17. { *********************************************************************** }
  18. { TRANSLATE is a simple keyboard redefinition program that gives the user }
  19. { the ability to translate five keys on the IBM enhanced keyboard to any  }
  20. { keys of his choice.  The user must know the word value of the key he    }
  21. { wishes to translate, and the word value for the key to which it should  }
  22. { be translated.  These values can be discovered with KEYWORD.            }
  23. {                                                                         }
  24. { TRANSLATE takes the following syntax:                                   }
  25. {                                                                         }
  26. { TRANSLAT oldkey1 newkey1 [oldkey2 newkey2] ... [oldkey5 newkey5]        }
  27. {                                                                         }
  28. { Both oldkey and newkey should be entered as #### where each # may be    }
  29. { of these characters: 0123456789ABCDEF.  Obviously the values are        }
  30. { hexadecimal.  All four characters should be filled, so if you have a    }
  31. { key with a value less than 1000h, you should pad the first digit(s)     }
  32. { with a zero (0).  Lower case characters are not allowed.  There must be }
  33. { at least one oldkey newkey pair, and may not be more than 5 pairs.      }
  34. { Each oldkey parameter must be matched by a newkey parameter.  If        }
  35. { TRANSLATE detects any errors it will not be installed, and an audible   }
  36. { beep will sound.                                                        }
  37. {                                                                         }
  38. { If TRANSLATE is successfully installed, it will watch for keys from the }
  39. { keyboard matching each oldkey, and replace its value with the           }
  40. { corresponding newkey.                                                   }
  41. { *********************************************************************** }
  42. { TRANSLATE requires Turbo Professional Toolbox from Turbo Power in order }
  43. { for it to be recompiled.                                                }
  44. { *********************************************************************** }
  45.  
  46.  
  47.  
  48. program translate;
  49. uses tpint,tptsr;
  50.  
  51. type
  52.   str5 = string[5];
  53.  
  54. var
  55.   Index : byte;
  56.   WordsToTrans : array[1..10] of word;
  57.   NumberOfWords : byte;
  58.  
  59. procedure TranslateIsr(BP : word); interrupt;
  60. var
  61.   Regs : IntRegisters absolute BP;
  62. begin
  63.   if (regs.ah = 0) or (regs.ah = $10) then begin
  64.     { Call old interrupt to get key into ax }
  65.     EmulateInt(Regs, ISR_Array[16].OrigAddr);
  66.     index := 255;                 { Same as -1, for a byte }
  67.     repeat
  68.       inc(index,2);
  69.       if WordsToTrans[index] = regs.ax then    { If the key in the table, }
  70.         regs.ax := WordsToTrans[index+1]       { translate it }
  71.     until (index = NumberOfWords);
  72.   end else
  73.     { Call old interrupt to perform other functions }
  74.     ChainInt(Regs, ISR_Array[16].OrigAddr);
  75. end;
  76.  
  77. function HexToWord(s : str5; var w : word) : boolean;
  78. var
  79.   i : byte;
  80. begin
  81.   HexToWord := false;  { Assume failure }
  82.  
  83.   if s[0] <> #4 then   { String must be 4 chars long }
  84.     exit;
  85.  
  86.   w := 0;
  87.   for i := 1 to 4 do begin
  88.     w := w * 16;
  89.     case s[i] of
  90.       '0'..'9' : w := w + ord(s[i]) - ord('0');
  91.       'A'..'F' : w := w + ord(s[i]) - ord('A') + 10;
  92.     else
  93.       exit;
  94.     end;
  95.   end;
  96.   HexToWord := true;
  97. end;
  98.  
  99. procedure error(x : byte);   { General purpose Error handler }
  100. begin
  101.   write(char(7));
  102.   halt(x);
  103. end;
  104.            { Main routine to set up TSR }
  105. begin
  106.   if (ParamCount mod 2 = 1) then
  107.     error(1)   { Odd number of parameters }
  108.   else if (ParamCount = 0) then
  109.     error(2)   { No parameters }
  110.   else if (ParamCount > 10) then
  111.     error(3);  { Too many parameters }
  112.  
  113.   for Index := 1 to ParamCount do
  114.     if not HexToWord(ParamStr(Index),WordsToTrans[Index]) then
  115.       error(4);  { Parameter improperly formed }
  116.  
  117.   NumberOfWords := ParamCount - 1;
  118.  
  119.   if not InitVector($16,16,@TranslateIsr) then;
  120.     { error(5)  { Only if handle (16) improper.  Impossible error. }
  121.   if not TerminateAndStayResident(ParagraphsToKeep, 0) then
  122.     error(6);   { Un able to release program's memory }
  123.  
  124. end.
  125.